home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / misc / excalc1.lha / ExCalcV1.1 / Source / Calculator.mod next >
Text File  |  1995-05-08  |  21KB  |  687 lines
  1. (*********************************************************************)
  2. (*                                                                   *)
  3. (* Module Calculator Copyright © 1995 by Computer Inspirations       *)
  4. (*                                                                   *)
  5. (* Design : Michael Griebling                                        *)
  6. (* Change : Original                                                 *)
  7. (*                                                                   *)
  8. (*********************************************************************)
  9.  
  10. MODULE Calculator;
  11.  
  12. IMPORT arg: Arguments, Cnv: Conversions, XI: ExIntegers, X: ExNumbers,
  13.        XM: ExMathLib0, io, iox: InOutExt, f: FileSystem, s: Strings,
  14.        Break;
  15.  
  16. TYPE
  17.   Tokens  = INTEGER;
  18.  
  19. CONST
  20.   (* Tokens definitions *)
  21.   Empty = 0;
  22.  
  23.  
  24.   (* expression tokens *)
  25.   Plus        = 1;
  26.   Minus       = 2;
  27.   Or          = 3;
  28.   Xor         = 4;
  29.   StoreMem    = 5;
  30.  
  31.  
  32.   (* term tokens *)
  33.   Times       = 6;
  34.   Divide      = 7;
  35.   ShiftLeft   = 8;
  36.   And         = 9;
  37.   Mod         = 10;
  38.   Div         = 11;
  39.   ClearBit    = 12;
  40.   SetBit      = 13;
  41.   ToggleBit   = 14;
  42.   AShiftRight = 15;
  43.   RotateRight = 16;
  44.   RotateLeft  = 17;
  45.   ShiftRight  = 18;
  46.  
  47.   (* power tokens *)
  48.   Power       = 19;
  49.   PercentOf   = 20;
  50.   Root        = 21;
  51.   Squared     = 22;
  52.   Cubed       = 23;
  53.   Inverse     = 24;
  54.   Factorial   = 25;
  55.  
  56.   (* miscellaneous tokens *)
  57.   LeftBrace   = 26;
  58.   RightBrace  = 27;
  59.   PowerOfe    = 28;
  60.   Sin         = 29;
  61.   Cos         = 30;
  62.   Tan         = 31;
  63.   ArcSin      = 32;
  64.   ArcCos      = 33;
  65.   ArcTan      = 34;
  66.   Sinh        = 35;
  67.   Cosh        = 36;
  68.   Tanh        = 37;
  69.   ArcSinh     = 38;
  70.   ArcCosh     = 39;
  71.   ArcTanh     = 40;
  72.   Not         = 41;
  73.   Base        = 42;
  74.   Digits      = 43;
  75.   Pi          = 44;
  76.   NaturalLog  = 45;
  77.   SquareRoot  = 46;
  78.   CubeRoot    = 47;
  79.   Decimals    = 48;
  80.   Notation    = 49;
  81.   Complement  = 50;
  82.   Log         = 51;
  83.   Number      = 52;
  84.   DegRadGrad  = 53;
  85.   MemoryCell  = 54;
  86.  
  87. CONST
  88.   MaxMemory        = 15;
  89.   StrSize          = 250;
  90.   Space            = ' ';
  91.   PunctuationChars = ",'_";
  92.   StateFile        = "RAM:CalculatorState.bin";
  93.  
  94.   (* DegRadType definitions *)
  95.   Degrees  = 0;
  96.   Radians  = 1;
  97.   Gradians = 2;
  98.  
  99. TYPE
  100.   String      = ARRAY StrSize OF CHAR;
  101.   SymbolArray = ARRAY MaxMemory+1 OF X.ExNumType;
  102.   DegRadType  = SHORTINT;
  103.   StateType   = RECORD
  104.                   LocalBase   : XI.BaseType;
  105.                   DecPoint    : INTEGER;
  106.                   SciNotation : BOOLEAN;
  107.                   NumbDigits  : INTEGER;
  108.                   LastAnswer  : X.ExNumType;
  109.                   DegRadFlag  : DegRadType;
  110.                   SymbolTable : SymbolArray;
  111.                 END;
  112.  
  113. VAR
  114.   Token       : Tokens;
  115.   NumberValue : X.ExNumType;
  116.   Answer      : X.ExNumType;
  117.   ToGradians  : X.ExNumType;
  118.   FromGradians: X.ExNumType;
  119.   State       : StateType;  (* Calculator state *)
  120.   ResultStr,
  121.   CommandLine : String;
  122.  
  123.  
  124. PROCEDURE SaveState;
  125. VAR
  126.   RFile : f.File;
  127. BEGIN
  128.   (* save calculator state *)
  129.   IF f.Open(RFile, StateFile, TRUE) &
  130.      f.Write(RFile, State)          &
  131.      f.Close(RFile) THEN END;
  132. END SaveState;
  133.  
  134.  
  135. PROCEDURE GetState;
  136. VAR
  137.   Loc   : INTEGER;
  138.   RFile : f.File;
  139. BEGIN
  140.   (* default calculator state *)
  141.   State.LocalBase   := 10;
  142.   State.DecPoint    :=  0;
  143.   State.SciNotation := FALSE;
  144.   State.NumbDigits  := 52;
  145.   State.DegRadFlag  := Degrees;
  146.   FOR Loc := 0 TO MaxMemory DO
  147.     State.SymbolTable[Loc] := X.Ex0;
  148.   END;
  149.  
  150.   (* get new state -- if available *)
  151.   IF f.Open(RFile, StateFile, FALSE) THEN
  152.     IF f.Read(RFile, State) & f.Close(RFile) THEN
  153.       X.SetMaxDigits(State.NumbDigits);
  154.     END;
  155.   END;
  156. END GetState;
  157.  
  158.  
  159. PROCEDURE UnsignInt (Number     : ARRAY OF CHAR;
  160.                      VAR Result : X.ExNumType);
  161. (* $CopyArrays- *)
  162. VAR
  163.   numb  : X.ExNumType;
  164.   done  : BOOLEAN;
  165. BEGIN
  166.   (* perform the actual conversion from string to number *)
  167.   IF State.LocalBase = 10 THEN
  168.     X.StrToExNum(Number, numb);
  169.     done := X.ExStatus = X.Okay;
  170.   ELSIF (State.LocalBase > 1) & (State.LocalBase <= 16) THEN
  171.     XI.StrToExInt(Number, State.LocalBase, numb);
  172.     done := X.ExStatus = X.Okay;
  173.   ELSE
  174.     done := FALSE;
  175.   END;
  176.   IF done THEN  (* all went OK *)
  177.     Result := numb;
  178.   ELSE
  179.     X.ExStatus := X.IllegalNumber;
  180.     Result := X.Ex0;
  181.   END;
  182. END UnsignInt;
  183.  
  184.  
  185. PROCEDURE LocateChar(Str : ARRAY OF CHAR; ch : CHAR;
  186.                      start : LONGINT) : LONGINT;
  187. (* $CopyArrays- *)
  188. VAR Find : ARRAY 2 OF CHAR;
  189. BEGIN
  190.   Find[0] := ch; Find[1] := 0X;
  191.   RETURN s.OccursPos(Str, Find, start);
  192. END LocateChar;
  193.  
  194.  
  195. PROCEDURE ExtractNumber(VAR arg         : ARRAY OF CHAR;
  196.                         VAR NumberValue : X.ExNumType);
  197. VAR
  198.   Constant    : String;
  199.   NumChars    : ARRAY 20 OF CHAR;
  200.   NumberChars : ARRAY 20 OF CHAR;
  201.   ConIndex    : INTEGER;
  202.  
  203.   PROCEDURE GetNumber();
  204.   BEGIN
  205.     LOOP
  206.       (* gather number characters *)
  207.       IF LocateChar(NumChars, arg[0], 0) # -1 THEN
  208.         (* not punctuation character *)
  209.         Constant[ConIndex] := arg[0];
  210.         INC(ConIndex);
  211.         IF (arg[0] = 'E') & (State.LocalBase = 10) THEN
  212.           IF (arg[1] = '+') OR (arg[1] = '-') THEN
  213.             Constant[ConIndex] := arg[1];
  214.             INC(ConIndex);
  215.             s.Delete(arg, 0, 1);
  216.           END;
  217.           s.Delete(NumChars, 0, 1); (* remove `.' *)
  218.         END;
  219.         s.Delete(arg, 0, 1);
  220.       ELSIF LocateChar(PunctuationChars, arg[0], 0) # -1 THEN
  221.         s.Delete(arg, 0, 1);
  222.       ELSE
  223.         EXIT;
  224.       END;
  225.       IF arg[0] = 0X THEN EXIT END;
  226.     END;
  227.   END GetNumber;
  228.  
  229. BEGIN
  230.   Constant := "";
  231.   ConIndex := 0;
  232.   NumberChars := ".E0123456789ABCDEF";
  233.  
  234.   (* valid number characters *)
  235.   IF State.LocalBase = 10 THEN
  236.     s.Cut(NumberChars, 0, 12, NumChars);
  237.   ELSE
  238.     s.Cut(NumberChars, 2, State.LocalBase+2, NumChars);
  239.   END;
  240.  
  241.   (* get a number string from the input *)
  242.   GetNumber();
  243.   Constant[ConIndex] := 0X;  (* terminate the new string *)
  244.  
  245.   (* convert to an ExNumber *)
  246.   IF ConIndex > 0 THEN
  247.     UnsignInt(Constant, NumberValue);
  248.   ELSE
  249.     NumberValue := X.Ex0;
  250.     X.ExStatus := X.IllegalNumber;  (* illegal number or constant *)
  251.   END;
  252. END ExtractNumber;
  253.  
  254.  
  255. PROCEDURE StoreMemory(Location, Value : X.ExNumType);
  256. (* Store the `Value' argument in the `Location' memory cell. *)
  257. VAR
  258.   Loc : LONGINT;
  259. BEGIN
  260.   Loc := X.ExToLongInt(Location);
  261.   IF Loc <= MaxMemory THEN
  262.     State.SymbolTable[Loc] := Value;
  263.   ELSE
  264.     X.ExStatus := X.UndefinedStorage;  (* unknown memory cell *)
  265.   END;
  266. END StoreMemory;
  267.  
  268.  
  269. PROCEDURE RecallMemory(Location : X.ExNumType; VAR Value : X.ExNumType);
  270. (* Recall the contents of the `Location' memory cell and return *)
  271. VAR
  272.   Loc : LONGINT;
  273. BEGIN
  274.   Loc := X.ExToLongInt(Location);
  275.   IF Loc <= MaxMemory THEN
  276.     Value := State.SymbolTable[Loc];
  277.   ELSE
  278.     X.ExStatus := X.UndefinedStorage;  (* unknown memory cell *)
  279.     Value := X.Ex0;
  280.   END;
  281. END RecallMemory;
  282.  
  283.  
  284. PROCEDURE ToRadians (InAngle : X.ExNumType; VAR Result : X.ExNumType);
  285. (* Convert from another angular representation to radians -- depending on
  286.    the state of the `DegRadFlag' *)
  287. BEGIN
  288.   IF State.DegRadFlag = Degrees THEN
  289.     Result := InAngle;
  290.     XM.DegToRadX(Result);
  291.   ELSIF State.DegRadFlag = Gradians THEN
  292.     X.ExMult(Result, FromGradians, InAngle);
  293.   ELSE
  294.     Result := InAngle
  295.   END;
  296. END ToRadians;
  297.  
  298.  
  299. PROCEDURE FromRadians (InAngle    : X.ExNumType;
  300.                        VAR Result : X.ExNumType);
  301. (* Convert to another angular representation from radians --
  302.    depending on the state of the `DegRadFlag' *)
  303. BEGIN
  304.   IF State.DegRadFlag = Degrees THEN
  305.     Result := InAngle;
  306.     XM.RadToDegX(Result)
  307.   ELSIF State.DegRadFlag = Gradians THEN
  308.     X.ExMult(Result, ToGradians, InAngle);
  309.   ELSE
  310.     Result := InAngle;
  311.   END;
  312. END FromRadians;
  313.  
  314.  
  315. PROCEDURE GetToken(VAR arg : ARRAY OF CHAR);
  316.  
  317. CONST
  318.   Sqrd = "\xB2";
  319.   Cubd = "\xB3";
  320.   Andd = "\xB7";
  321.   Tims = "\xD7";
  322.   Divd = "\xF7";
  323.   Min1 = "\xAD\xB9";
  324.  
  325.   PROCEDURE IsToken(Str : ARRAY OF CHAR;
  326.                     T   : Tokens) : BOOLEAN;
  327.   BEGIN
  328.     IF s.OccursPos(arg, Str, 0) = 0 THEN
  329.       s.Delete(arg, 0, s.Length(Str));
  330.       Token := T;
  331.       RETURN TRUE;
  332.     END;
  333.     RETURN FALSE;
  334.   END IsToken;
  335.  
  336. BEGIN
  337.   (* delete any blank spaces *)
  338.   WHILE arg[0] = Space DO s.Delete(arg, 0, 1); END;
  339.  
  340.   (* form a token *)
  341.   IF ((arg[0] >= '0') & (arg[0] <= '9')) OR (arg[0] = '.') THEN
  342.     (* token is some sort of number *)
  343.     Token := Number;
  344.     ExtractNumber(arg, NumberValue);
  345.   ELSIF arg[0] = 0X THEN
  346.     (* empty string *)
  347.     Token := Empty;
  348.   ELSE
  349.     (* token is a symbol *)
  350.     IF IsToken("+",     Plus)        THEN RETURN END;
  351.     IF IsToken("-",     Minus)       THEN RETURN END;
  352.     IF IsToken(Sqrd,    Squared)     THEN RETURN END;
  353.     IF IsToken(Cubd,    Cubed)       THEN RETURN END;
  354.     IF IsToken("x",     Times)       THEN RETURN END;
  355.     IF IsToken(Tims,    Times)       THEN RETURN END;
  356.     IF IsToken("/",     Divide)      THEN RETURN END;
  357.     IF IsToken(Divd,    Divide)      THEN RETURN END;
  358.     IF IsToken("(",     LeftBrace)   THEN RETURN END;
  359.     IF IsToken(")",     RightBrace)  THEN RETURN END;
  360.     IF IsToken("^",     Power)       THEN RETURN END;
  361.     IF IsToken("%",     PercentOf)   THEN RETURN END;
  362.     IF IsToken("!",     Factorial)   THEN RETURN END;
  363.     IF IsToken("&",     And)         THEN RETURN END;
  364.     IF IsToken(Andd,    And)         THEN RETURN END;
  365.     IF IsToken("|",     Or)          THEN RETURN END;
  366.     IF IsToken("e^",    PowerOfe)    THEN RETURN END;
  367.     IF IsToken("e",     Number)      THEN NumberValue := X.e;
  368.                                           RETURN END;
  369.     IF IsToken(Min1,    Inverse)     THEN RETURN END;
  370.     IF IsToken("**",    Power)       THEN RETURN END;
  371.     IF IsToken("*",     Times)       THEN RETURN END;
  372.     IF IsToken("BAS",   Base)        THEN RETURN END;
  373.     IF IsToken("OR",    Or)          THEN RETURN END;
  374.     IF IsToken("Pi",    Number)      THEN NumberValue := X.pi;
  375.                                           RETURN END;
  376.     IF IsToken("SBIT",  SetBit)      THEN RETURN END;
  377.     IF IsToken("SHR",   ShiftRight)  THEN RETURN END;
  378.     IF IsToken("SHL",   ShiftLeft)   THEN RETURN END;
  379.     IF IsToken("SINH",  Sinh)        THEN RETURN END;
  380.     IF IsToken("SIN",   Sin)         THEN RETURN END;
  381.     IF IsToken("SQRT",  SquareRoot)  THEN RETURN END;
  382.     IF IsToken("STM",   StoreMem)    THEN RETURN END;
  383.     IF IsToken("SCI",   Notation)    THEN RETURN END;
  384.     IF IsToken("AND",   And)         THEN RETURN END;
  385.     IF IsToken("ASINH", ArcSinh)     THEN RETURN END;
  386.     IF IsToken("ASIN",  ArcSin)      THEN RETURN END;
  387.     IF IsToken("ASR",   AShiftRight) THEN RETURN END;
  388.     IF IsToken("ACOSH", ArcCosh)     THEN RETURN END;
  389.     IF IsToken("ACOS",  ArcCos)      THEN RETURN END;
  390.     IF IsToken("ATANH", ArcTanh)     THEN RETURN END;
  391.     IF IsToken("ATAN",  ArcTan)      THEN RETURN END;
  392.     IF IsToken("XOR",   Xor)         THEN RETURN END;
  393.     IF IsToken("MOD",   Mod)         THEN RETURN END;
  394.     IF IsToken("M",     MemoryCell)  THEN
  395.       ExtractNumber(arg, NumberValue);    RETURN END;
  396.     IF IsToken("LOG",   Log)         THEN RETURN END;
  397.     IF IsToken("LN",    NaturalLog)  THEN RETURN END;
  398.     IF IsToken("DIV",   Div)         THEN RETURN END;
  399.     IF IsToken("DP",    Decimals)    THEN RETURN END;
  400.     IF IsToken("DRG",   DegRadGrad)  THEN RETURN END;
  401.     IF IsToken("CBIT",  ClearBit)    THEN RETURN END;
  402.     IF IsToken("CBRT",  CubeRoot)    THEN RETURN END;
  403.     IF IsToken("COSH",  Cosh)        THEN RETURN END;
  404.     IF IsToken("COS",   Cos)         THEN RETURN END;
  405.     IF IsToken("NOT",   Complement)  THEN RETURN END;
  406.     IF IsToken("ROOT",  Root)        THEN RETURN END;
  407.     IF IsToken("ROL",   RotateLeft)  THEN RETURN END;
  408.     IF IsToken("ROR",   RotateRight) THEN RETURN END;
  409.     IF IsToken("TANH",  Tanh)        THEN RETURN END;
  410.     IF IsToken("TAN",   Tan)         THEN RETURN END;
  411.     IF IsToken("TBIT",  ToggleBit)   THEN RETURN END;
  412.     IF IsToken("DIG",   Digits)      THEN RETURN END;
  413.  
  414.     (* Illegal token if we reach here *)
  415.     X.ExStatus := X.IllegalOperator;
  416.     s.Delete(arg, 0, 1);
  417.   END;
  418. END GetToken;
  419.  
  420.  
  421. PROCEDURE^ Expression (VAR arg : ARRAY OF CHAR; VAR Result : X.ExNumType);
  422.  
  423.  
  424. PROCEDURE Factor (VAR arg : ARRAY OF CHAR; VAR Result : X.ExNumType);
  425. VAR
  426.   SaveBase : XI.BaseType;
  427.   temp     : X.ExNumType;
  428.  
  429.   PROCEDURE Next;
  430.   BEGIN
  431.     GetToken(arg); Factor(arg, Result);
  432.   END Next;
  433.  
  434. BEGIN
  435.   CASE Token OF
  436.       LeftBrace  : GetToken(arg); Expression(arg, Result);
  437.                    IF Token = RightBrace THEN GetToken(arg);
  438.                    ELSE X.ExStatus := X.MismatchBraces END;
  439.     | Number     : GetToken(arg); Result := NumberValue;
  440.                    IF Token = Number THEN
  441.                      X.ExStatus := X.IllegalNumber;
  442.                    END;
  443.     | Complement : Next(); XI.ExOnesComp(Result, Result);
  444.     | Sin        : Next(); ToRadians(Result, Result);
  445.                    XM.sinX(Result, Result);
  446.     | Cos        : Next(); ToRadians(Result, Result);
  447.                    XM.cosX(Result, Result);
  448.     | Tan        : Next(); ToRadians(Result, Result);
  449.                    XM.tanX(Result, Result);
  450.     | ArcSin     : Next(); XM.arcsinX(Result, Result);
  451.                    FromRadians(Result, Result);
  452.     | ArcCos     : Next(); XM.arccosX(Result, Result);
  453.                    FromRadians(Result, Result);
  454.     | ArcTan     : Next(); XM.arctanX(Result, Result);
  455.                    FromRadians(Result, Result);
  456.     | Sinh       : Next(); XM.sinhX(Result, Result);
  457.     | Cosh       : Next(); XM.coshX(Result, Result);
  458.     | Tanh       : Next(); XM.tanhX(Result, Result);
  459.     | ArcSinh    : Next(); XM.arcsinhX(Result, Result);
  460.     | ArcCosh    : Next(); XM.arccoshX(Result, Result);
  461.     | ArcTanh    : Next(); XM.arctanhX(Result, Result);
  462.     | SquareRoot : Next(); XM.sqrtX(Result, Result);
  463.     | CubeRoot   : Next(); X.ExNumb(3, 0, 0, temp);
  464.                    XM.rootX(Result, Result, temp);
  465.     | NaturalLog : Next(); XM.lnX(Result, Result);
  466.     | Log        : Next(); XM.logX(Result, Result);
  467.     | PowerOfe   : Next(); XM.expX(Result, Result);
  468.     | MemoryCell : GetToken(arg); RecallMemory(NumberValue, Result);
  469.     | Base       : SaveBase := State.LocalBase;
  470.                    State.LocalBase := 10;
  471.                    Next();
  472.                    State.LocalBase := SHORT(SHORT(X.ExToLongInt(Result)));
  473.                    IF (State.LocalBase < 2) OR
  474.                       (State.LocalBase > 16) THEN
  475.                      State.LocalBase := SaveBase;
  476.                    END;
  477.                    Result := State.LastAnswer;
  478.     | Digits     : Next();
  479.                    IF X.ExStatus = X.Okay THEN
  480.                      State.NumbDigits := SHORT(X.ExToLongInt(Result));
  481.                      X.SetMaxDigits(State.NumbDigits);
  482.                      State.NumbDigits := X.GetMaxDigits();
  483.                      Result := State.LastAnswer;
  484.                    END;
  485.     | Decimals   : Next();
  486.                    IF X.ExStatus = X.Okay THEN
  487.                      State.DecPoint := SHORT(X.ExToLongInt(Result));
  488.                      Result := State.LastAnswer;
  489.                    END;
  490.     | Notation   : GetToken(arg);
  491.                    State.SciNotation := NOT State.SciNotation;
  492.                    Result := State.LastAnswer;
  493.     | DegRadGrad : GetToken(arg);
  494.                    IF State.DegRadFlag = Gradians THEN
  495.                      State.DegRadFlag := Degrees;
  496.                    ELSE INC(State.DegRadFlag) END;
  497.                    Result := State.LastAnswer;
  498.     ELSE           X.ExStatus := X.IllegalOperator;
  499.                    Result := X.Ex0;
  500.   END;
  501. END Factor;
  502.  
  503.  
  504. PROCEDURE Powers (VAR arg : ARRAY OF CHAR; VAR Result : X.ExNumType);
  505. VAR
  506.   temp : X.ExNumType;
  507.  
  508.   PROCEDURE Next;
  509.   BEGIN
  510.     GetToken(arg); Factor(arg, Result);
  511.   END Next;
  512.  
  513. BEGIN
  514.   Factor(arg, temp);
  515.   WHILE (Token >= Power) & (Token <= Factorial) DO
  516.     CASE Token OF
  517.         Power     : Next(); XM.powerX(temp, temp, Result);
  518.       | Root      : Next(); XM.rootX(temp, Result, temp);
  519.       | Squared   : GetToken(arg); X.ExMult(temp, temp, temp);
  520.       | Cubed     : GetToken(arg); XM.xtoi(temp, temp, 3);
  521.       | Inverse   : GetToken(arg); X.ExDiv(temp, X.Ex1, temp);
  522.       | Factorial : GetToken(arg);
  523.                     XM.factorialX(temp, X.ExToLongInt(temp));
  524.       | PercentOf : GetToken(arg);
  525.                     X.ExNumb(0, 1, -1, Result);        (* 0.01 *)
  526.                     X.ExMult(Result, temp, Result);
  527.                     Factor(arg, temp);
  528.                     X.ExMult(temp, temp, Result);
  529.       ELSE (* skip token *)
  530.                     X.ExStatus := X.IllegalOperator;
  531.                     GetToken(arg);
  532.     END;
  533.   END;
  534.   Result := temp;
  535. END Powers;
  536.  
  537.  
  538. PROCEDURE Term (VAR arg : ARRAY OF CHAR; VAR Result : X.ExNumType);
  539. VAR
  540.   temp, temp2 : X.ExNumType;
  541.  
  542.   PROCEDURE Next;
  543.   BEGIN
  544.     GetToken(arg); Powers(arg, Result);
  545.   END Next;
  546.  
  547.   PROCEDURE ToCard(Ex : X.ExNumType) : INTEGER;
  548.   BEGIN
  549.     RETURN SHORT(X.ExToLongInt(Ex));
  550.   END ToCard;
  551.  
  552. BEGIN
  553.   Powers(arg, temp);
  554.   WHILE (Token >= Times) & (Token <= ShiftRight) DO
  555.     CASE Token OF
  556.         Times       : Next(); X.ExMult(temp, Result, temp);
  557.       | Divide      : Next(); X.ExDiv(temp, temp, Result);
  558.       | Div         : Next(); XI.ExIntDiv(temp, temp, Result);
  559.       | Mod         : Next(); XI.ExMod(temp, temp, Result);
  560.       | And         : Next(); XI.ExAnd(temp, temp, Result);
  561.       | ShiftRight  : Next(); XI.ExShr(temp, temp, ToCard(Result));
  562.       | AShiftRight : Next(); XI.ExAshr(temp, temp, ToCard(Result));
  563.       | RotateRight : Next(); XI.ExRor(temp, temp, ToCard(Result));
  564.       | ShiftLeft   : Next(); XI.ExShl(temp, temp, ToCard(Result));
  565.       | RotateLeft  : Next(); XI.ExRol(temp, temp, ToCard(Result));
  566.       | ClearBit    : Next(); XI.ExClearBit(temp, temp, ToCard(Result));
  567.       | SetBit      : Next(); XI.ExSetBit(temp, temp, ToCard(Result));
  568.       | ToggleBit   : Next(); XI.ExToggleBit(temp, temp, ToCard(Result));
  569.       ELSE (* skip token *)
  570.                       GetToken(arg); X.ExStatus := X.IllegalOperator;
  571.     END;
  572.   END;
  573.   Result := temp;
  574. END Term;
  575.  
  576.  
  577. PROCEDURE Expression (VAR arg : ARRAY OF CHAR;
  578.                       VAR Result : X.ExNumType);
  579. VAR
  580.   temp : X.ExNumType;
  581.   Str  : String;
  582.  
  583.   PROCEDURE Next(VAR Result : X.ExNumType);
  584.   BEGIN
  585.     GetToken(arg); Term(arg, Result);
  586.   END Next;
  587.  
  588. BEGIN
  589.   CASE Token OF
  590.       Plus  : Next(temp);
  591.     | Minus : Next(temp); X.ExChgSign(temp);
  592.       ELSE    Term(arg, temp)
  593.   END;
  594.   WHILE (Token >= Plus) & (Token <= StoreMem) DO
  595.     CASE Token OF
  596.         Plus     : Next(Result); X.ExAdd(temp, temp, Result);
  597.       | Minus    : Next(Result); X.ExSub(temp, temp, Result);
  598.       | Or       : Next(Result); XI.ExOr(temp, Result, temp);
  599.       | Xor      : Next(Result); XI.ExXor(temp, Result, temp);
  600.       | StoreMem : Next(Result); StoreMemory(Result, temp);
  601.       ELSE         Term(arg, temp);
  602.     END;
  603.   END;
  604.   Result := temp;
  605. END Expression;
  606.  
  607.  
  608. PROCEDURE SimpleExpression (VAR arg : ARRAY OF CHAR;
  609.                             VAR Result : X.ExNumType);
  610. BEGIN
  611.   X.ExStatus := X.Okay;(* clear out any previous errors         *)
  612.   GetToken(arg);   (* start things off with the first token *)
  613.   Expression(arg, Result);
  614.   State.LastAnswer := Result;
  615. END SimpleExpression;
  616.  
  617.  
  618. PROCEDURE GetCLI(VAR Str : ARRAY OF CHAR) : BOOLEAN;
  619. BEGIN
  620.   IF arg.NumArgs() < 1 THEN
  621.     Str := "";
  622.     RETURN FALSE;
  623.   ELSE
  624.     arg.GetArg(1, Str);
  625.     RETURN TRUE;
  626.   END;
  627. END GetCLI;
  628.  
  629.  
  630. PROCEDURE WriteAsString(x : X.ExNumType);
  631. BEGIN
  632.   IF State.LocalBase = 10 THEN
  633.     IF State.SciNotation THEN
  634.       X.ExNumToStr(x, State.DecPoint, 1, ResultStr);
  635.     ELSE
  636.       X.ExNumToStr(x, State.DecPoint, 0, ResultStr);
  637.     END;
  638.   ELSE
  639.     XI.ExIntToStr(x, State.LocalBase, ResultStr);
  640.   END;
  641.   IF X.ExStatus = X.Okay THEN
  642.     io.WriteString(ResultStr);
  643.   ELSE
  644.     io.WriteString("Illegal input string!");
  645.   END;
  646.   io.WriteLn;
  647. END WriteAsString;
  648.  
  649.  
  650. BEGIN
  651.   (* Local gradian conversion constants *)
  652.   X.StrToExNum(
  653.   "1.570796326794896619231321691639751442098584699687555E-2",
  654.   FromGradians);
  655.   X.StrToExNum(
  656.   "6.366197723675813430755350534900574481378385829618240E+1",
  657.   ToGradians);
  658.  
  659.   Token := Empty;
  660.   GetState();
  661.   LOOP
  662.     IF GetCLI(CommandLine) THEN
  663.       SimpleExpression(CommandLine, Answer);
  664.       WriteAsString(Answer);
  665.       EXIT;
  666.     END;
  667.     io.WriteString("Calc");
  668.     CASE State.DegRadFlag OF
  669.       | Degrees  : io.Write("D")
  670.       | Radians  : io.Write("R")
  671.       | Gradians : io.Write("G")
  672.     END;
  673.     IF State.LocalBase # 10 THEN
  674.       io.WriteString("Bas");
  675.       io.WriteInt(State.LocalBase, 1);
  676.     END;
  677.     io.WriteString("> ");
  678.     iox.ReadLine(CommandLine);
  679.     IF s.Length(CommandLine) = 0 THEN
  680.       EXIT;
  681.     END;
  682.     SimpleExpression(CommandLine, Answer);
  683.     WriteAsString(Answer);
  684.   END;
  685.   SaveState();
  686. END Calculator.
  687.